home *** CD-ROM | disk | FTP | other *** search
/ Clickx 115 / Clickx 115.iso / software / tools / windows / tails-i386-0.16.iso / live / filesystem.squashfs / usr / share / perl5 / IO / Lines.pm < prev    next >
Encoding:
Perl POD Document  |  2005-02-10  |  4.2 KB  |  185 lines
  1. package IO::Lines;
  2.  
  3.  
  4. =head1 NAME
  5.  
  6. IO::Lines - IO:: interface for reading/writing an array of lines
  7.  
  8.  
  9. =head1 SYNOPSIS
  10.  
  11.     use IO::Lines;
  12.  
  13.     ### See IO::ScalarArray for details 
  14.  
  15.  
  16. =head1 DESCRIPTION
  17.  
  18. This class implements objects which behave just like FileHandle
  19. (or IO::Handle) objects, except that you may use them to write to
  20. (or read from) an array of lines.  They can be tiehandle'd as well.  
  21.  
  22. This is a subclass of L<IO::ScalarArray|IO::ScalarArray> 
  23. in which the underlying
  24. array has its data stored in a line-oriented-format: that is,
  25. every element ends in a C<"\n">, with the possible exception of the
  26. final element.  This makes C<getline()> I<much> more efficient;
  27. if you plan to do line-oriented reading/printing, you want this class.
  28.  
  29. The C<print()> method will enforce this rule, so you can print
  30. arbitrary data to the line-array: it will break the data at
  31. newlines appropriately.
  32.  
  33. See L<IO::ScalarArray> for full usage and warnings.
  34.  
  35. =cut
  36.  
  37. use Carp;
  38. use strict;
  39. use IO::ScalarArray;
  40. use vars qw($VERSION @ISA);
  41.  
  42. # The package version, both in 1.23 style *and* usable by MakeMaker:
  43. $VERSION = "2.110";
  44.  
  45. # Inheritance:
  46. @ISA = qw(IO::ScalarArray);     ### also gets us new_tie  :-)
  47.  
  48.  
  49. #------------------------------
  50. #
  51. # getline
  52. #
  53. # Instance method, override.
  54. # Return the next line, or undef on end of data.
  55. # Can safely be called in an array context.
  56. # Currently, lines are delimited by "\n".
  57. #
  58. sub getline {
  59.     my $self = shift;
  60.  
  61.     if (!defined $/) {
  62.     return join( '', $self->_getlines_for_newlines );
  63.     }
  64.     elsif ($/ eq "\n") {
  65.     if (!*$self->{Pos}) {      ### full line...
  66.         return *$self->{AR}[*$self->{Str}++];
  67.     }
  68.     else {                     ### partial line...
  69.         my $partial = substr(*$self->{AR}[*$self->{Str}++], *$self->{Pos});
  70.         *$self->{Pos} = 0;
  71.         return $partial;
  72.     }
  73.     }
  74.     else {
  75.     croak 'unsupported $/: must be "\n" or undef';
  76.     }
  77. }
  78.  
  79. #------------------------------
  80. #
  81. # getlines
  82. #
  83. # Instance method, override.
  84. # Return an array comprised of the remaining lines, or () on end of data.
  85. # Must be called in an array context.
  86. # Currently, lines are delimited by "\n".
  87. #
  88. sub getlines {
  89.     my $self = shift;
  90.     wantarray or croak("can't call getlines in scalar context!");
  91.  
  92.     if ((defined $/) and ($/ eq "\n")) {
  93.     return $self->_getlines_for_newlines(@_);
  94.     }
  95.     else {         ### slow but steady
  96.     return $self->SUPER::getlines(@_);
  97.     }
  98. }
  99.  
  100. #------------------------------
  101. #
  102. # _getlines_for_newlines
  103. #
  104. # Instance method, private.
  105. # If $/ is newline, do fast getlines.
  106. # This CAN NOT invoke getline!
  107. #
  108. sub _getlines_for_newlines {
  109.     my $self = shift;
  110.     my ($rArray, $Str, $Pos) = @{*$self}{ qw( AR Str Pos ) };
  111.     my @partial = ();
  112.  
  113.     if ($Pos) {                ### partial line...
  114.     @partial = (substr( $rArray->[ $Str++ ], $Pos ));
  115.     *$self->{Pos} = 0;
  116.     }
  117.     *$self->{Str} = scalar @$rArray;    ### about to exhaust @$rArray
  118.     return (@partial,
  119.         @$rArray[ $Str .. $#$rArray ]);    ### remaining full lines...
  120. }
  121.  
  122. #------------------------------
  123. #
  124. # print ARGS...
  125. #
  126. # Instance method, override.
  127. # Print ARGS to the underlying line array.  
  128. #
  129. sub print {
  130.     if (defined $\ && $\ ne "\n") {
  131.     croak 'unsupported $\: must be "\n" or undef';
  132.     }
  133.  
  134.     my $self = shift;
  135.     ### print STDERR "\n[[ARRAY WAS...\n", @{*$self->{AR}}, "<<EOF>>\n";
  136.     my @lines = split /^/, join('', @_); @lines or return 1;
  137.  
  138.     ### Did the previous print not end with a newline?  
  139.     ### If so, append first line:
  140.     if (@{*$self->{AR}} and (*$self->{AR}[-1] !~ /\n\Z/)) {
  141.     *$self->{AR}[-1] .= shift @lines;
  142.     }
  143.     push @{*$self->{AR}}, @lines;       ### add the remainder
  144.     ### print STDERR "\n[[ARRAY IS NOW...\n", @{*$self->{AR}}, "<<EOF>>\n";
  145.     1;
  146. }
  147.  
  148. #------------------------------
  149. 1;
  150.  
  151. __END__
  152.  
  153.  
  154. =head1 VERSION
  155.  
  156. $Id: Lines.pm,v 1.3 2005/02/10 21:21:53 dfs Exp $
  157.  
  158.  
  159. =head1 AUTHORS
  160.  
  161.  
  162. =head2 Primary Maintainer
  163.  
  164. David F. Skoll (F<dfs@roaringpenguin.com>).
  165.  
  166. =head2 Principal author
  167.  
  168. Eryq (F<eryq@zeegee.com>).
  169. President, ZeeGee Software Inc (F<http://www.zeegee.com>).
  170.  
  171.  
  172. =head2 Other contributors 
  173.  
  174. Thanks to the following individuals for their invaluable contributions
  175. (if I've forgotten or misspelled your name, please email me!):
  176.  
  177. I<Morris M. Siegel,>
  178. for his $/ patch and the new C<getlines()>.
  179.  
  180. I<Doug Wilson,>
  181. for the IO::Handle inheritance and automatic tie-ing.
  182.  
  183. =cut
  184.  
  185.